home *** CD-ROM | disk | FTP | other *** search
/ PC World Interactive 7 / PC World Interactive 7.iso / program / qbprog.EXE / KODLA.BAS < prev    next >
BASIC Source File  |  1980-01-10  |  4KB  |  131 lines
  1. DECLARE SUB GeriKodla (Yer, Tip$)
  2. DECLARE SUB Kodla (A$)
  3. DECLARE SUB Kontrol (D$)
  4.  
  5. SCREEN 2: SCREEN 0: COLOR 7, 1: CLS
  6. A$ = COMMAND$
  7. IF A$ = "" THEN
  8.    PRINT "Program ÿnternet üzerinde dosyalarì mektup olarak göndermek";
  9.    PRINT "için kodlar"
  10.    PRINT "Programì ƒöyle kullanìn:≈KODLA DOSYA.ADI≈"
  11.    END
  12. END IF
  13.  
  14. OPEN A$ FOR BINARY AS #1
  15. IF LOF(1) = 0 THEN CLOSE : KILL A$: PRINT A$; " bulunamadì!!": END
  16. Kontrol (A$)
  17.  
  18. SUB GeriKodla (Yer, Tip$)
  19.      A$ = SPACE$(4096): GET #1, 1, A$
  20.      Yer2 = INSTR(Yer, A$, " "): Yer3 = INSTR(Yer2, A$, CHR$(10))
  21.      Dosya$ = MID$(A$, Yer, Yer2 - Yer)
  22.      Buyukluk = VAL(MID$(A$, Yer2, Yer3 - Yer2))
  23.      SEEK #1, Yer3 + 2: Yer = 0
  24.  
  25.      OPEN Dosya$ FOR BINARY AS #2
  26.      IF LOF(2) <> 0 THEN
  27.         PRINT Dosya$; " isminde bir dosya bulundu!!! Üstüne yazayìm mì? E/H"
  28.       DO
  29.         A$ = INKEY$
  30.         SELECT CASE A$
  31.               CASE "E", "e"
  32.                  CLOSE #2: KILL Dosya$
  33.                  OPEN Dosya$ FOR BINARY AS #2: CLS : EXIT DO
  34.               CASE "H", "h"
  35.                  END
  36.         END SELECT
  37.       LOOP
  38.      END IF
  39.      LOCATE 1, 1
  40.      PRINT Dosya$; Buyukluk; " Geri kodlama yapìlìyor % 00";
  41.      Sutun = POS(0) - 3
  42. DO
  43.   Yer = Yer + 4
  44.   A$ = " ": GET #1, , A$: Toplam# = (ASC(A$) - 32) * 262144#
  45.   A$ = " ": GET #1, , A$: Toplam# = Toplam# + (ASC(A$) - 32) * 4096#
  46.   A$ = " ": GET #1, , A$: Toplam# = Toplam# + (ASC(A$) - 32) * 64
  47.   A$ = " ": GET #1, , A$: Toplam# = Toplam# + ASC(A$) - 32
  48.   Top = Toplam# \ 65536#: A$ = CHR$(Top): Toplam# = Toplam# - Top * 65536#
  49.   Top = Toplam# \ 256#: A$ = CHR$(Top) + A$: Toplam# = Toplam# - Top * 256#
  50.   A$ = CHR$(Toplam#) + A$
  51.   IF LOF(2) < Buyukluk - 3 THEN
  52.       PUT #2, , A$
  53.   ELSE
  54.       A$ = MID$(A$, 1, Buyukluk - LOF(2)): PUT #2, , A$: EXIT DO
  55.   END IF
  56.   LOCATE 1, Sutun: COLOR 14, 1: PRINT LOF(2) * 100 \ Buyukluk;
  57.   IF Yer = 60 THEN A$ = Tip$: GET #1, , A$: Yer = 0
  58. LOOP
  59.   PRINT : PRINT "Dönüƒtürme tamamlandì.": END
  60. END SUB
  61.  
  62. SUB Kodla (A$)
  63.     Yer = INSTR(A$, ".") - 1: IF Yer = -1 THEN Yer = LEN(A$)
  64.     B$ = LEFT$(A$, Yer) + ".KOD"
  65.     OPEN B$ FOR BINARY AS #2
  66.     IF LOF(2) <> 0 THEN
  67.       PRINT B$; " olarak kodlanm샠olabilir üstüne yazayìm mì? E/H"
  68.       DO
  69.         C$ = INKEY$
  70.         SELECT CASE C$
  71.               CASE "E", "e"
  72.                  CLOSE #2: KILL B$: OPEN B$ FOR BINARY AS #2: CLS : EXIT DO
  73.               CASE "H", "h"
  74.                  END
  75.         END SELECT
  76.       LOOP
  77.     END IF
  78.     LOCATE 1, 1: PRINT A$; " Kodlama yapìlìyor % 00  "; B$; " olarak..";
  79.     Sutun = POS(0) - LEN(B$) - 14: COLOR 14, 1
  80.     Enter$ = CHR$(13) + CHR$(10): Son$ = Enter$ + "G"
  81.     A$ = "Girdi " + A$ + STR$(LOF(1)) + Son$: PUT #2, , A$: Yer = 0
  82.  
  83.     SEEK #1, 1: Yer = 0
  84.  
  85. DO
  86.     IF LOC(1) = LOF(1) THEN EXIT DO
  87.     LOCATE 1, Sutun: PRINT LOC(1) * 100 \ LOF(1);
  88.     A$ = " ": GET #1, , A$: Toplam# = ASC(A$)
  89.     A$ = " ": GET #1, , A$: Toplam# = Toplam# + ASC(A$) * 256#
  90.     A$ = " ": GET #1, , A$: Toplam# = Toplam# + ASC(A$) * 65536#
  91.  
  92.     Yer = Yer + 4
  93.     Top = Toplam# \ 262144#: A$ = CHR$(Top + 32): PUT #2, , A$
  94.     Toplam# = Toplam# - Top * 262144#
  95.     Top = Toplam# \ 4096#: A$ = CHR$(Top + 32): PUT #2, , A$
  96.     Toplam# = Toplam# - Top * 4096#
  97.     Top = Toplam# \ 64#: A$ = CHR$(Top + 32): PUT #2, , A$
  98.     Toplam# = Toplam# - Top * 64#
  99.     A$ = CHR$(Toplam# + 32): PUT #2, , A$
  100.  
  101.     IF Yer = 60 THEN Yer = 0: PUT #2, , Son$
  102. LOOP
  103.     A$ = Enter$ + "Bitti" + Enter$: PUT #2, , A$: PRINT
  104.     PRINT "Mektup formatìna dönüƒtürüldü...": END
  105. END SUB
  106.  
  107. SUB Kontrol (D$)
  108.    Yer = 1
  109.    DO
  110.      A$ = SPACE$(4096): GET #1, 1, A$: Yer = INSTR(Yer, A$, "Girdi ") + 6
  111.      IF Yer <= 6 THEN Kodla (D$)
  112.      Yer2 = INSTR(Yer, A$, " "): Yer3 = INSTR(Yer2, A$, CHR$(10))
  113.  
  114.      SELECT CASE MID$(A$, Yer3 - 1, 1)
  115.             CASE CHR$(13)
  116.              Tip$ = "   "
  117.              Atla = 63
  118.             CASE ELSE
  119.              Tip$ = "  "
  120.              Atla = 62
  121.      END SELECT
  122.      Evet = 1
  123.      FOR i = Yer3 + 1 TO Yer3 + 1 + Atla * 5 STEP Atla
  124.          IF i > LOF(1) THEN EXIT FOR
  125.          IF MID$(A$, i, 1) <> "G" THEN Evet = 0
  126.      NEXT
  127.      IF Evet = 1 THEN CALL GeriKodla(Yer, Tip$)
  128.    LOOP
  129. END SUB
  130.  
  131.